;; import lists/member.scm lists/assoc.scm lists/make-list.scm

(define (opener? b)
  (member b '(#\( #\[ #\{)))

(define (closer? b)
  (member b '(#\) #\] #\})))

(define (matching? a b)
  (member (list a b)
	  '((#\( #\))
	    (#\[ #\])
	    (#\{ #\}))))

(define (close-bracket a)
  (cdr (assoc a
	      '((#\( . #\))
		(#\[ . #\])
		(#\{ . #\})))))

(define (point-at place)
  (list->string (append (make-list place #\-) (list #\^))))

(define (parse input)
  (let loop ((stack '())
	     (l (string->list input))
	     (loc 0)
	     (working-stack '())
	     (tree (lambda (rest) rest)))
    (if (null? l)
	(if (null? stack)
	    (tree '())
	    (begin (print "Error: unclosed bracket")
		   (print input)
		   (print (point-at (cdar stack)))
		   #f))
	(let ((bracket (car l)))
	  (if (opener? bracket)
	      (loop (cons (cons bracket loc)
			  stack)
		    (cdr l)
		    (+ loc 1)
		    (cons tree working-stack)
		    (lambda (rest)
		      (cons 'open (cons bracket rest))))
	      (if (closer? bracket)
		  (if (null? stack)
		      (begin (print "Error: too many close brackets")
			     (print input)
			     (print (point-at loc))
			     #f)
		      (let ((top (car stack)))
			(if (matching? (car top) bracket)
			    (loop (cdr stack)
				  (cdr l)
				  (+ loc 1)
				  (cdr working-stack)
				  (lambda (rest)
				    ((car working-stack)
				     (cons (tree '()) rest))))
			    (begin (print "Error: bracket mismatch")
				   (print input)
				   (print (point-at (cdr top)))
				   (print (point-at loc))
				   #f))))
		  (loop stack (cdr l) (+ loc 1)
			working-stack
			(lambda (rest)
			  (tree (cons (car l) rest))))))))))

(define (print-tree indent t)
  (if (or (not t) (null? t))
      #t
      (if (char? t)
	  (begin (display (list->string (make-list indent #\space)))
		 (display t)
		 (newline))
	  (let ((head (car t)))
	    (if (equal? 'open head)
		(begin
		  (display (list->string (make-list indent #\space)))
		  (display (cadr t))
		  (newline)
		  (for-each (lambda (t)
			      (print-tree (+ indent 2) t))
			    (cddr t))
		  (display (list->string (make-list indent #\space)))
		  (display (close-bracket (cadr t)))
		  (newline))
		(for-each (lambda (t)
			    (print-tree indent t))
			  t))))))

(define (go t)
  (write-line `(parsing ,t))
  (print-tree 0 (parse t))
  (newline))

(go "")
(go "aaa(bbb")
(go "aaa)bbb")
(go "aa(bb)cc")
(go "xx(yyyyyy]zzzz")
(go "h[e[ll]o]")
(go "w(o(r)l[d])")
(go "(((()))[][]{{}{}})")
